home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tclm_1_0.lha / tclm-1.0 / mseq < prev    next >
Text File  |  1993-08-16  |  8KB  |  298 lines
  1. #!/usr/local/bin/tclm -f
  2. #
  3. # Copyright (c) 1993 Michael B. Durian.  All rights reserved.
  4. #
  5. # Redistribution and use in source and binary forms, with or without
  6. # modification, are permitted provided that the following conditions
  7. # are met:
  8. # 1. Redistributions of source code must retain the above copyright
  9. #    notice, this list of conditions and the following disclaimer.
  10. # 2. Redistributions in binary form must reproduce the above copyright
  11. #    notice, this list of conditions and the following disclaimer in the
  12. #    documentation and/or other materials provided with the distribution.
  13. # 3. All advertising materials mentioning features or use of this software
  14. #    must display the following acknowledgement:
  15. #    This product includes software developed by Michael B. Durian.
  16. # 4. The name of the the Author may be used to endorse or promote 
  17. #    products derived from this software without specific prior written 
  18. #    permission.
  19. #
  20. # THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 
  21. # WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  22. # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  
  23. # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
  24. # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  25. # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  26. # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  27. # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  28. # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  29. # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  30. # SUCH DAMAGE.
  31.  
  32. # mseq,v 1.4 1993/04/08 04:16:05 durian Exp
  33.  
  34. set ScopeList ""
  35. set CurrentScope ""
  36. set ScopeDuration long
  37.  
  38. set TrackNumber 0
  39. set CurrentTrack ""
  40.  
  41. set InFileName stdin
  42. set OutFileName stdout
  43. set LineNumber 0
  44.  
  45. set Division -1
  46.  
  47. proc ReadLine {file} {
  48.     global LineNumber
  49.  
  50.     # we want to skip blank lines
  51.     # and escape both curly braces
  52.     if {[gets $file line0] == -1} {
  53.         return ""
  54.     }
  55.     incr LineNumber
  56.     if {![regsub -all \{ $line0 \\\{ line1]} {
  57.         set line1 $line0
  58.     }
  59.     if {![regsub -all \} $line1 \\\} line2]} {
  60.         set line2 $line1
  61.     }
  62.     while {[llength $line2] == 0} {
  63.         if {[gets $file line0] == -1} {
  64.             return ""
  65.         }
  66.         incr LineNumber
  67.         if {![regsub -all \{ $line0 \\\{ line1]} {
  68.             set line1 $line0
  69.         }
  70.         if {![regsub -all \{ $line2 \\\{ line1]} {
  71.             set line2 $line1
  72.         }
  73.     }
  74.     return $line2
  75. }
  76.  
  77.  
  78. proc CollapseAndAdd {outfile infilename outtimes} {
  79.     global Division
  80.  
  81.     if {[catch {open $infilename "r"} file]} {
  82.         puts stderr $file
  83.         exit 1
  84.     }
  85.     set infile [midiread $file]
  86.     set outtime0 [lindex $outtimes 0]
  87.     set outtime1 [lindex $outtimes 1]
  88.  
  89.     set form [midiconfig $infile format]
  90.     if {[midiconfig $infile format] != 1} {
  91.         puts stderr "Sorry!  mseq only handles format 1 files currently."
  92.         exit 1
  93.     }
  94.     if {$Division == -1} {
  95.         set Division [midiconfig $infile division]
  96.         set scalar 1
  97.     } else {
  98.         set scalar [expr {[midiconfig $infile division] / $Division}]
  99.     }
  100.  
  101.     # copy over track 0
  102.     set outtime0 [midimerge "$outfile 0" "\"$infile 0 $scalar\"" $outtime0]
  103.  
  104.     # now merge the other tracks to track 1
  105.     set num_tracks [midiconfig $infile tracks]
  106.     for {set i 1} {$i < $num_tracks} {incr i} {
  107.         lappend inputs "$infile $i $scalar"
  108.     }
  109.     set outtime1 [midimerge "$outfile 1" $inputs $outtime1]
  110.  
  111.     midifree $infile
  112.     close $file
  113.  
  114.     return "$outtime0 $outtime1"
  115. }
  116.  
  117. # parse command line args
  118. # mseq [input.seq [output.mid]]
  119. if {[string compare [lindex $argv 0] -f] == 0} {
  120.     set argv [lrange $argv 2 end]
  121.     set argc [expr {$argc - 2}]
  122. }
  123. if {$argc > 2} {
  124.     puts stderr "Usage: mseq [input.seq [output.mid]]"
  125.     exit 1
  126. }
  127.  
  128. set InFile stdin
  129. set OutFile stdout
  130. if {$argc > 0} {
  131.     set InFileName [lindex $argv 0]
  132.     if {[catch {open $InFileName "r"} InFile]} {
  133.         puts stderr $InFile
  134.         exit 1
  135.     }
  136.     if {$argc > 1} {
  137.         set OutFileName [lindex $argv 1]
  138.         set OutFile [open $OutFileName "w"]
  139.         if {[catch {open $OutFileName "w"} OutFile]} {
  140.             puts stderr $OutFile
  141.             exit 1
  142.         }
  143.     }
  144. }
  145.  
  146.  
  147. # pretty ugly huh?
  148. # get a line and stick it into the variable line
  149. # also get the length of that same line
  150. # and stick that result in the variable line_length
  151. # then check to see if that is zero
  152. while {[set line_length [llength [set line [ReadLine $InFile]]]] != 0} {
  153.     set comment 0
  154.     for {set i 0} {$i < $line_length} {incr i} {
  155.         set word [lindex $line $i]
  156.         case $word in {
  157.         "*:" {
  158.             # this is a label
  159.             set ScopeList [linsert $ScopeList 0 $word]
  160.             set CurrentScope $word
  161.             set ScopeDuration short
  162.         } "\{" {
  163.             # this opens a block
  164.             set ScopeDuration long
  165.         } "\}" {
  166.             # this closes a block
  167.             set ScopeList [lrange $ScopeList 1 end]
  168.             set CurrentScope [lindex $ScopeList 0]
  169.         } "repeat" {
  170.             if {[llength $ScopeList] == 0} {
  171.                 puts stderr "No track specified"
  172.                 puts stderr "Line $LineNumber File: $InFileName"
  173.                 exit 1
  174.             }
  175.             # our one and only command
  176.             incr i
  177.             if {$i == $line_length} {
  178.                 puts stderr [concat "Must follow \"repeat\" "\
  179.                     "with a block name"]
  180.                 puts stderr "Line $LineNumber File: $InFileName"
  181.                 exit 1
  182.             }
  183.             set block [lindex $line $i]
  184.             incr i
  185.             if {$i < $line_length} {
  186.                 set num_repeats [lindex $line $i]
  187.             } else {
  188.                 set num_repeats 1
  189.             }
  190.             for {set j 0} {$j < $num_repeats} {incr j} {
  191.                 # some major contortions to get
  192.                 # recursive variable names
  193.                 set var "\$${CurrentTrack}($block)"
  194.  
  195.                 foreach scope $ScopeList {
  196.                     eval "append ${CurrentTrack}($scope) \
  197.                         { } $var"
  198.                 }
  199.             }
  200.         } "track" {
  201.             if {[llength $ScopeList] > 1} {
  202.                 puts stderr "No nesting tracks"
  203.                 puts stderr "Line $LineNumber File: $InFileName"
  204.                 exit 1
  205.             }
  206.             set ScopeList main:
  207.             set CurrentScope main:
  208.             set CurrentTrack track${TrackNumber}
  209.             incr TrackNumber
  210.         } "#" {
  211.             set comment 1
  212.         } default {
  213.             # other wise we're a file name
  214.             # we must append word to all scopes in ScopeList
  215.             if {[llength $ScopeList] == 0} {
  216.                 puts stderr "No track specified"
  217.                 puts stderr "Line $LineNumber File: $InFileName"
  218.                 exit 1
  219.             }
  220.             foreach scope $ScopeList {
  221.                 lappend ${CurrentTrack}($scope) $word
  222.             }
  223.             if {[string compare $ScopeDuration short] == 0} {
  224.                 set ScopeList [lrange $ScopeList 1 end]
  225.                 set CurrentScope [lindex $ScopeList 0]
  226.                 set ScopeDuration long
  227.             }
  228.         }
  229.         }
  230.         if {$comment} {
  231.             break
  232.         }
  233.     }
  234. }
  235.  
  236. for {set i 0} {$i < $TrackNumber} {incr i} {
  237.     puts stderr "Track [expr {$i + 1}]:"
  238.     set var track${i}(main:)
  239.     puts stderr [eval "set $var"]
  240.     puts stderr ""
  241.  
  242.     # we want to collapse and concat each track to a mfile
  243.     set mfile [midimake]
  244.     midiconfig $mfile format 1
  245.     midiconfig $mfile tracks 2
  246.     lappend MFileList $mfile
  247.  
  248.     # initially we are at the begining of the track
  249.     set track_time "0 0"
  250.     foreach filename [eval "set $var"] {
  251.         set track_time [CollapseAndAdd $mfile $filename $track_time]
  252.     }
  253.  
  254.     # set the division to what was determined by CollapseAndAdd
  255.     midiconfig $mfile division $Division
  256.  
  257.     # stick eot's on tracks 0 and 1
  258.     midiput $mfile 0 [lindex $track_time 0] metaeot
  259.     midiput $mfile 1 [lindex $track_time 1] metaeot
  260.  
  261.     # and rewind it for future use
  262.     midirewind $mfile
  263.  
  264. }
  265.  
  266. # and then create one final mfile from each individual track mfile
  267. # track 0's must merge - other tracks stay separate
  268. set moutfile [midimake]
  269. midiconfig $moutfile format 1
  270. midiconfig $moutfile track [expr {$TrackNumber + 1}]
  271. midiconfig $moutfile division $Division
  272.  
  273. # by now everything is in the same division so we can use tscalars of 1
  274.  
  275. puts stderr "Final Merge"
  276.  
  277. # make track 0 merge list
  278. # and append other tracks
  279. set track 1
  280. foreach mfile $MFileList {
  281.     lappend mlist "$mfile 0 1"
  282.     set d [midimerge "$moutfile $track" "\"$mfile 1 1\"" 0]
  283.     midiput $moutfile $track $d metaeot
  284.     incr track
  285. }
  286.  
  287. set delta0 [midimerge "$moutfile 0" $mlist 0]
  288. midiput $moutfile 0 $delta0 metaeot
  289.  
  290. foreach mfile $MFileList {
  291.     midifree $mfile
  292. }
  293.  
  294. midiwrite $moutfile $OutFile
  295. midifree $moutfile
  296. close $OutFile
  297. exit 0
  298.